home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 June: Reference Library / Dev.CD Jun 94.toast / Periodicals / develop / develop Issue 5 / develop 5 code / Lisp Mini-App / Program / menus.lisp < prev    next >
Encoding:
Text File  |  1992-04-08  |  21.1 KB  |  569 lines  |  [TEXT/CCL2]
  1. #|
  2.    menus.lisp
  3.  
  4.    Defines the menubar, menus, menu-items and their behavior used in the 
  5.    Mini-Application sample program.
  6.  
  7.    For further info, see files "About Mini-App" and "Instructions".
  8.  
  9.  
  10.    Copyright 1990, 1991 by Ruben Kleiman for Apple Computer, Inc.
  11.  
  12.    Change History.
  13.    03-12-92 slm  Rearranged lexical order of Options menu menu-items to better
  14.                  match the actual order in the menu.
  15.    03-10-92 slm  The menu-item-action method for create-by-rectangle-menu-item
  16.                  ignores palettes.
  17.    03-09-92 slm  Updated file header comments.
  18.    03-08-92 slm  In new-menu-item-action, added ":color-p *color-available*"
  19.                  to "make-instance 'draw-dialog" as changed the class of
  20.                  of draw-dialog from color-dialog to dialog.
  21.    03-07-92 slm  Cut, Copy, Paste and Clear changed to window-menu-items
  22.                  to specialize them for draw-dialogs.
  23.                  The clear menu-item-action was also changed to cope when
  24.                  there's no draw-dialog and to only operate on the front window.
  25.    01-19-92 slm  Added: (message-dialog "Never implemented!")  (6x)
  26.    01-17-92 slm  (front-window 'draw-dialog) -> 
  27.                  (front-window :class 'draw-dialog)  (2x)
  28.  
  29. |#
  30.  
  31. ;;; ______________________________________________________________________________________
  32. ;;; Define menus
  33.  
  34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35. ;;; *mini-application-file-menu*
  36. ;;;
  37. ;;;   This will be our FILE menu.  Its menu items are defined further down.
  38. ;;;
  39. (setq *mini-application-file-menu*
  40.   (make-instance 'menu
  41.                  :menu-title "File"))
  42.  
  43. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44. ;;; *mini-application-edit-menu*
  45. ;;;
  46. ;;;   This will be our EDIT menu.  Its menu items are defined further down.
  47. ;;;
  48. (setq *mini-application-edit-menu* 
  49.   (make-instance 'menu
  50.                  :menu-title "Edit"))
  51.  
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53. ;;; *mini-application-options-menu*
  54. ;;;
  55. ;;;   This will be our OPTIONS menu.  Its menu items are defined further down.
  56. ;;;
  57. (setq *mini-application-options-menu*
  58.   (make-instance 'menu
  59.                  :menu-title "Options"))
  60.  
  61. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  62. ;;; *selected-object-menu-indicator*
  63. ;;;
  64. ;;;   This menu will be displayed whenever an object is selected in the frontmost
  65. ;;;   draw-dialog window.  The menu's name will be the name of the object.
  66. ;;;
  67. (setq *selected-object-menu-indicator*
  68.       (make-instance 'menu
  69.                      :menu-title ""))
  70.  
  71. ;;; _____________________________________________________________________________________
  72. ;;; Define menubar
  73.  
  74. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  75. ;;; *mini-application-menubar*
  76. ;;;
  77. ;;;   This is our menubar.  It is a list of the menus created above.
  78. ;;;   The menus haven't yet been assigned menu items:  this is done further down.
  79. ;;;
  80. (setq *mini-application-menubar* 
  81.       (list *mini-application-file-menu*
  82.             *mini-application-edit-menu*
  83.             *mini-application-options-menu*
  84.             *windows-menu*           ; We will borrow the convenient MCL WINDOWS menu
  85.             *selected-object-menu-indicator*))
  86.  
  87. ;;; _____________________________________________________________________________________
  88. ;;; Define all of the menu items
  89.  
  90. ;;; __________________________________
  91. ;;; Define FILE menu items:
  92.  
  93. ;;; _____________________
  94. ;;; FILE NEW menu item.
  95.  
  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97. ;;; *file-new-menu-item*
  98. ;;;
  99. ;;;   This is the FILE menu's NEW menu item.  When selected, this menu item calls the function
  100. ;;;   NEW-MENU-ITEM-ACTION, which creates a new window (an instance of our class DRAW-DIALOG).
  101. ;;;
  102. (setq *file-new-menu-item*
  103.   (make-instance 'menu-item
  104.                  :menu-item-title "New"
  105.                  :command-key #\N
  106.                  :menu-item-action 'new-menu-item-action))
  107.  
  108. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  109. ;;; new-menu-item-action
  110. ;;;
  111. ;;;   Called by the File menu New menu item.  Creates a new window.
  112. ;;;
  113. (defun new-menu-item-action ()
  114.   (make-instance 'draw-dialog
  115.                  :window-title  (format nil "Draw Dialog ~a" (incf *window-count*))
  116.                  :view-size     #@(300 300)
  117.                  :view-position (make-point 5 40)
  118.                  :color-p       *color-available*
  119.                  :window-type   :document-with-zoom))
  120.  
  121. ;;; ______________________
  122. ;;; FILE CLOSE menu item
  123.  
  124. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  125. ;;; *file-close-menu-item*
  126. ;;;
  127. ;;;   This is the FILE menu's CLOSE menu item.  When selected, this menu item calls the
  128. ;;;   function CLOSE-MENU-ITEM-ACTION, which closes ANY type of window in the front.
  129. ;;;
  130. (setq *file-close-menu-item*
  131.   (make-instance 'menu-item
  132.                  :menu-item-title "Close"
  133.                  :command-key #\W
  134.                  :menu-item-action 'close-menu-item-action))
  135.  
  136. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  137. ;;; close-menu-item-action
  138. ;;;
  139. ;;;   Called by the FILE menu CLOSE menu item.  Closes frontmost window.
  140. ;;;
  141. (defun close-menu-item-action ()
  142.   (window-close (front-window)))
  143.  
  144. ;;; ______________________
  145. ;;; FILE QUIT menu item
  146.  
  147. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  148. ;;; *file-quit-menu-item*
  149. ;;;
  150. ;;;   This is the FILE menu's QUIT menu item.  When selected, this menu item calls the
  151. ;;;   function QUIT-MENU-ITEM-ACTION, which quits our application and returns to MCL.
  152. ;;;
  153. (setq *file-quit-menu-item*
  154.   (make-instance 'menu-item
  155.                  :menu-item-title "Quit"
  156.                  :command-key #\Q
  157.                  :menu-item-action 'quit-menu-item-action))
  158.  
  159. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  160. ;;; quit-menu-item-action
  161. ;;;
  162. ;;;   Called by the FILE menu QUIT menu item.  Goes back to MCL.
  163. ;;;
  164. (defun quit-menu-item-action ()
  165.   (set-menubar *default-menubar*))  ; The *default-menubar* is MCL's menubar.
  166.  
  167.  
  168. ;;; ______________________
  169. ;;; Install the FILE menu items into the FILE menu
  170. ;;;
  171.  
  172. (add-menu-items *mini-application-file-menu*
  173.                 *file-new-menu-item*
  174.                 *file-close-menu-item*
  175.                 *file-quit-menu-item*)
  176.  
  177.  
  178. ;;; ________________________________________
  179. ;;; Define EDIT menu items
  180.  
  181.  
  182. ;;; _____________________
  183. ;;; EDIT CUT menu item
  184.  
  185. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  186. ;;; *cut-menu-item*
  187. ;;;
  188. ;;;   This is the EDIT menu's CUT menu item.  When selected, this menu cuts the selected
  189. ;;;   object, if any, in the frontmost drawing window.
  190. ;;;
  191. (setq *cut-menu-item*
  192.   (make-instance 'window-menu-item
  193.           :menu-item-title "Cut"
  194.         ; :disabled t    more complicated to deal with
  195.           :command-key #\X
  196.           :menu-item-action 'cut))
  197.  
  198. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  199. ;;; cut menu-item-action
  200. ;;;
  201. ;;;   Called by EDIT menu's CUT menu item.  Left as an
  202. ;;;   exercise to the reader!
  203. ;;;
  204. (defmethod cut ((w draw-dialog))
  205.   (ed-beep)
  206.   (message-dialog "Never implemented!"))
  207.  
  208. ;;; _____________________
  209. ;;; EDIT COPY menu item
  210.  
  211. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  212. ;;; *copy-menu-item*
  213. ;;;
  214. ;;;   This is the EDIT menu's COPY menu item.  When selected, this menu copies the
  215. ;;;   selected object, if any, in the frontmost drawing window.
  216. ;;;
  217. (setq *copy-menu-item*
  218.   (make-instance 'window-menu-item
  219.           :menu-item-title "Copy"
  220.         ; :disabled t    more complicated to deal with
  221.           :command-key #\C
  222.           :menu-item-action 'copy))
  223.  
  224. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  225. ;;; copy menu-item-action
  226. ;;;
  227. ;;;   Called by EDIT's COPY menu item.  Left as an exercise
  228. ;;;   to the reader!
  229. ;;;
  230. (defmethod copy ((w draw-dialog))
  231.   (ed-beep)
  232.   (message-dialog "Never implemented!"))
  233.  
  234. ;;; _____________________
  235. ;;; EDIT PASTE menu item
  236.  
  237. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  238. ;;; *paste-menu-item*
  239. ;;;
  240. ;;;   This is the EDIT menu's PASTE menu item.  When selected, this menu pastes the
  241. ;;;   last copied object, if any, into the frontmost drawing window.
  242. ;;;
  243. (setq *paste-menu-item*
  244.   (make-instance 'window-menu-item
  245.           :menu-item-title "Paste"
  246.           :command-key #\V
  247.           :menu-item-action 'paste))
  248.  
  249. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  250. ;;; paste menu-item-action
  251. ;;;
  252. ;;;   Called by EDIT's PASTE menu item.  Left as an exercise
  253. ;;;   to the reader!
  254. ;;;
  255. (defmethod paste ((w draw-dialog))
  256.   (ed-beep)
  257.   (message-dialog "Never implemented!"))
  258.  
  259. ;;; ______________________
  260. ;;; EDIT CLEAR menu item
  261.  
  262. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  263. ;;; *clear-menu-item*
  264. ;;;
  265. ;;;   This is the EDIT menu's CLEAR menu item.  When selected, this menu clears the
  266. ;;;   selected object, if any, in the frontmost drawing window.
  267. ;;;
  268. (setq *clear-menu-item*
  269.   (make-instance 'window-menu-item
  270.           :menu-item-title "Clear"
  271.         ; :disabled t    more complicated to deal with
  272.           :menu-item-action 'clear))
  273.  
  274. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  275. ;;; clear menu-item-action
  276. ;;;
  277. ;;;   Called by EDIT menu's CLEAR menu item.
  278. ;;;
  279. (defmethod clear ((window draw-dialog))
  280.   (when (neq (type-of window) 'palette)            ; Make sure that it isn't a palette
  281.     (dolist (item (slot-value window 'selections)) ; Look through selection(s)
  282.       (remove-subviews window item)                ; Remove selection from window
  283.       (dispose-record (slot-value item 'rectangle) :rect))  ; Dispose draw-item rectangle
  284.     (view-draw-contents window)))   ; Redraw the window to get rid of obsoleted draw-item items
  285.  
  286. ;;; ______________________
  287. ;;; Install the EDIT menu items into the EDIT menu.
  288. ;;;
  289. (add-menu-items *mini-application-edit-menu*
  290.                 *cut-menu-item*
  291.                 *copy-menu-item*
  292.                 *paste-menu-item*
  293.                 *clear-menu-item*)
  294.  
  295.  
  296. ;;; ________________________________________
  297. ;;; Define the OPTIONS menu items:
  298.  
  299. ;;; _____________________________________
  300. ;;; OPTIONS menu's PALETTE menu item
  301.  
  302. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  303. ;;; *palette-menu-item*
  304. ;;;
  305. ;;;   This is the OPTIONS menu's PALETTE menu item.  When selected, it will call
  306. ;;;   PALETTE-MENU-ITEM, which will show the palette if it is hidden, else it
  307. ;;;   will hide the palette.
  308. ;;;
  309. (setq *palette-menu-item*
  310.   (make-instance 'menu-item
  311.                  :menu-item-title "Palette"
  312.                  :menu-item-action 'palette-menu-item))
  313.  
  314. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  315. ;;; palette-menu-item
  316. ;;;
  317. ;;;   This is called when the Options menu's Palette menu item is selected
  318. ;;;   We want to enable the Palette menu item when the palette is displayed.
  319. ;;;   Also, if there is no palette and the user selects this item, then
  320. ;;;   we want to show it; else we want to hide (not close) it.
  321. ;;;
  322. (defun palette-menu-item ()
  323.   (let ((palette-shown (menu-item-enabled-p *palette-menu-item*))
  324.         (palette (car (windows :class 'palette))))
  325.     (if (and palette-shown
  326.              palette)
  327.       (window-close palette)  ;; there is a defined method for palettes!
  328.       (show-palette))
  329.     (menu-item-disable *palette-menu-item*)))
  330.  
  331. ;;; ___________________________________
  332. ;;; OPTIONS menu WINDOW INFO menu item
  333.  
  334. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  335. ;;; *window-object-info-menu-item*
  336. ;;;
  337. ;;;   This is the OPTIONS menu's WINDOW INFO menu item.  When selected, this menu item calls
  338. ;;;   SHOW-WINDOW-INFO, which will let the user show information about
  339. ;;;   the frontmost drawing window.
  340. ;;;
  341. (setq *window-object-info-menu-item*
  342.   (make-instance 'menu-item
  343.                  :disabled t
  344.                  :menu-item-title "Window Info..."
  345.                  :menu-item-action 'show-window-info))
  346.  
  347. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  348. ;;; show-window-info
  349. ;;;
  350. ;;;   Called by the OPTIONS menu's WINDOW INFO menu item.
  351. ;;;   Shows information about the frontmost window, if it is a draw-dialog window.
  352. ;;;
  353. (defun show-window-info ()
  354.   (ed-beep)
  355.   (message-dialog "Never implemented!"))
  356.  
  357. ;;; _____________________________________
  358. ;;; OPTIONS menu WINDOW SCRIPT menu item
  359.  
  360. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  361. ;;; *window-script-menu-item*
  362. ;;;
  363. ;;;   This is the OPTIONS menu's WINDOW SCRIPT menu item.  When selected, this menu item calls
  364. ;;;   EDIT-WINDOW-SCRIPT, which will let the user edit the script for 
  365. ;;;   the frontmost drawing window.
  366. ;;;
  367. (setq *window-script-menu-item*
  368.   (make-instance 'menu-item
  369.                  :menu-item-title "Window Script..."
  370.                  :disabled t
  371.                  :menu-item-action 'edit-window-script))
  372.  
  373. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  374. ;;; edit-window-script
  375. ;;;
  376. ;;;   Called by the OPTIONS menu's WINDOW SCRIPT menu item.
  377. ;;;
  378. (defun edit-window-script ()
  379.   (ed-beep)
  380.   (message-dialog "Never implemented!"))
  381.  
  382. ;;; ________________________________
  383. ;;; OBJECT INFO menu item
  384.  
  385. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  386. ;;; *object-info-menu-item*
  387. ;;;
  388. ;;;   This is the OPTIONS menu's OBJECT INFO menu item.  When selected, this menu item calls
  389. ;;;   SHOW-OBJECT-INFO, which will try to display a dialog box with information about
  390. ;;;   the currently selected object(s) in the frontmost drawing window.
  391. ;;;
  392. (setq *object-info-menu-item*
  393.   (make-instance 'menu-item
  394.                  :menu-item-title "Object Info..."
  395.                  :disabled t
  396.                  :command-key #\I
  397.                  :menu-item-action 'show-object-info))
  398.  
  399. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  400. ;;; show-object-info
  401. ;;;
  402. ;;;   This gets called whenever we wish to obtain the information boxes
  403. ;;;   for one or more objects.  If the objects are not supplied, then
  404. ;;;   look at the objects selected in the frontmost DRAW-DIALOG class window.
  405. ;;;   This function can be called by the Object Info...
  406. ;;;   menu item, or by the author-mode-double-click-handler generic function.
  407. ;;;
  408. (defun show-object-info (&rest objects)
  409.   (if objects
  410.     ;; Show an information box for each object
  411.     (dolist (object objects)
  412.       ;; the method show-info does the real work:
  413.       (show-info object))
  414.     ;; Show an information box for each selected object in the frontmost window
  415.     (let ((draw-windows (windows :class 'draw-window)))
  416.       (if (and draw-windows
  417.                (slot-value (first draw-windows) 'selections))
  418.         (show-object-info (slot-value (first draw-windows) 'selections))))))
  419.  
  420. ;;; _____________________________________
  421. ;;; OPTIONS menu OBJECT SCRIPT menu item
  422.  
  423. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  424. ;;; *object-script-menu-item*
  425. ;;;
  426. ;;;   This is the OPTIONS menu's OBJECT SCRIPT menu item.  When selected, this menu item calls
  427. ;;;   EDIT-OBJECT-SCRIPT, which will let the user edit the script for
  428. ;;;   the currently selected object(s) in the frontmost drawing window.
  429. ;;;
  430. (setq *object-script-menu-item*
  431.   (make-instance 'menu-item
  432.                  :menu-item-title "Object Script..."
  433.                  :disabled t
  434.                  :menu-item-action 'edit-object-script))
  435.  
  436. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  437. ;;; edit-object-script
  438. ;;;
  439. ;;;   Called by OPTIONS menu's OBJECT SCRIPT menu item.
  440. ;;;   If given an object argument, will allow editing of the object's script.
  441. ;;;   Else, it will look at the selected object, if any, in the frontmost
  442. ;;;   draw window and allow editing of its script.
  443. ;;; 
  444. (defun edit-object-script (&optional object)
  445.   (declare (ignore object))
  446.   (ed-beep)
  447.   (message-dialog "Never implemented!"))
  448.  
  449. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  450. ;;; *bring-to-front-menu-item*
  451. ;;;
  452. ;;;   This is the OPTION menu's BRING TO FRONT menu item.  When selected, this menu item
  453. ;;;   calls BRING-OBJECT-TO-FRONT, which will bring the currently selected object
  454. ;;;   in the frontmost draw-dialog window to the front of the window.
  455. ;;;
  456. (setq *bring-to-front-menu-item*
  457.       (make-instance 'menu-item
  458.                      :menu-item-title "Selection To Front"
  459.                      :menu-item-action 'bring-selection-to-front))
  460.  
  461. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  462. ;;; bring-selection-to-front
  463. ;;;
  464. ;;;   Called by the OPTIONS menu's SELECTION TO FRONT menu item.
  465. ;;;   Tells the window to do it.
  466. ;;;
  467. (defun bring-selection-to-front ()
  468.   (let ((draw-window (car (windows :class 'draw-dialog))))
  469.     (and draw-window
  470.          (bring-item-to-front draw-window))))
  471.  
  472.  
  473. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  474. ;;; create-by-rectangle-menu-item
  475. ;;;
  476. ;;; A subclass of MENU-ITEM whose action is to allow or disallow
  477. ;;; creation of object by dragging out a rectangle in the frontmost
  478. ;;; draw-dialog window.
  479. ;;;
  480. (defclass create-by-rectangle-menu-item (menu-item) ())
  481.  
  482. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  483. ;;; *create-by-rectangle-menu-item*
  484. ;;;
  485. ;;;    This is the OPTION menu's CREATE BY RECTANGLE menu item.  When selected,
  486. ;;;    this menu item will allow or discontinue creation of objects on draw-dialogs
  487. ;;;    by selecting and dragging out a rectangle on the window. It has no other
  488. ;;;    purpose.
  489. ;;;
  490. (setq *create-by-rectangle-menu-item*
  491.       (make-instance 'create-by-rectangle-menu-item
  492.                      :menu-item-title "Create By Rectangle"))
  493.  
  494. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  495. ;;; menu-item-action [create-by-rectangle-menu-item]
  496. ;;;
  497. ;;;    This gets called whenever the "Create By Rectangle" menu item is selected
  498. ;;;    by the user.  The action is to check or uncheck the menu item and
  499. ;;;    to set the create-by-rectangle mode of the draw-dialog window in the front.
  500. ;;;
  501. (defmethod menu-item-action ((item create-by-rectangle-menu-item))
  502.   (let ((draw-dialog-window (front-window :class 'draw-dialog)))
  503.     (when (and draw-dialog-window
  504.                (neq (type-of draw-dialog-window) 'palette)) ; Make sure that it isn't a palette
  505.       (set-menu-item-check-mark item (not (menu-item-check-mark item)))
  506.       (setf (slot-value draw-dialog-window 'create-by-rectangle)
  507.             (not (slot-value draw-dialog-window 'create-by-rectangle))))))
  508.  
  509. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  510. ;;; *go-to-lisp-menubar-menu-item*
  511. ;;;
  512. ;;;    This is the OPTION menu's GO TO LISP MENUBAR menu item.  When selected, it
  513. ;;;    will change the menubar to the regular Lisp menubar.
  514. ;;;
  515. (setq *go-to-lisp-menubar-menu-item*
  516.       (make-instance 'menu-item
  517.                      :menu-item-title "Go To Lisp Menubar"
  518.                      :menu-item-action #'(lambda ()
  519.                                            (set-menubar *default-menubar*))))
  520.  
  521. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  522. ;;; *mini-application-options-menu*
  523. ;;;
  524. ;;;   Install the Option menu items into the Options menu:
  525. ;;;
  526. (add-menu-items *mini-application-options-menu*
  527.                 *palette-menu-item*
  528.                 (make-instance 'menu-item :menu-item-title "-")  ; Dividing line
  529.                 *window-object-info-menu-item*
  530.                 *window-script-menu-item*
  531.                 (make-instance 'menu-item :menu-item-title "-")
  532.                 *object-script-menu-item*
  533.                 *object-info-menu-item*
  534.                 *bring-to-front-menu-item*
  535.                 *create-by-rectangle-menu-item*
  536.                 (make-instance 'menu-item :menu-item-title "-")
  537.                 *go-to-lisp-menubar-menu-item*)
  538.  
  539.  
  540. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  541. ;;; *tools-menu*
  542. ;;;
  543. ;;;   We add a menu item to the end of the Lisp TOOLS menu which will allow
  544. ;;;   us to go back to our mini-application from the Lisp menubar.
  545. ;;;   This facilitates switching back and forth between the two environments.
  546. ;;;
  547. (add-menu-items *tools-menu*
  548.                 (make-instance 'menu-item :menu-item-title "-")   ; A menu item divider line
  549.                 (make-instance 'menu-item
  550.                                :menu-item-title "Go To Mini-Application"
  551.                                :menu-item-action #'(lambda ()
  552.                                                      (set-menubar *mini-application-menubar*))))
  553.  
  554.  
  555. ;;; _______________________________________________________________________________________
  556. ;;; Menu Initialization
  557. ;;;
  558.  
  559. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  560. ;;; show-menus
  561. ;;;
  562. ;;;   This gets called when our application starts up
  563. ;;;
  564. (defun show-menus ()
  565.   (set-menubar *mini-application-menubar*))
  566.  
  567. ;end of file menus.lisp
  568. ;------------------------------------------------
  569.